PC World Interactive 7/PC World Interactive 7.iso/program/vbkontrol.exe/IPD_102N.ZIP/FTP.FRM

Visual Basic Form | 1995-06-24 | 12.6 KB | 430 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "FTP Demo - Please refer to RFC959 for more info."
   ClientHeight    =   5385
   ClientLeft      =   1185
   ClientTop       =   1500
   ClientWidth     =   8640
   Height          =   5790
   Left            =   1125
   LinkTopic       =   "Form1"
   ScaleHeight     =   5385
   ScaleWidth      =   8640
   Top             =   1155
   Width           =   8760
   Begin Frame Frame2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Operation"
      Height          =   1095
      Left            =   3120
      TabIndex        =   20
      Top             =   1080
      Width           =   1935
      Begin OptionButton oWhat
         BackColor       =   &H00C0C0C0&
         Caption         =   "List"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   23
         Top             =   720
         Width           =   1335
      End
      Begin OptionButton oWhat
         BackColor       =   &H00C0C0C0&
         Caption         =   "<--Download"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   22
         Top             =   480
         Width           =   1455
      End
      Begin OptionButton oWhat
         BackColor       =   &H00C0C0C0&
         Caption         =   "Upload-->"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   21
         Top             =   240
         Value           =   -1  'True
         Width           =   1335
      End
   End
   Begin CommandButton Command2
      Caption         =   "GO!!"
      Height          =   375
      Left            =   5400
      TabIndex        =   19
      Top             =   1800
      Width           =   1215
   End
   Begin CommandButton Command1
      Caption         =   "Cancel"
      Height          =   375
      Left            =   6840
      TabIndex        =   18
      Top             =   1800
      Width           =   1095
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "PI State"
      Height          =   1335
      Left            =   6960
      TabIndex        =   14
      Top             =   0
      Width           =   1575
      Begin OptionButton oState
         BackColor       =   &H00C0C0C0&
         Caption         =   "COMMAND"
         Enabled         =   0   'False
         ForeColor       =   &H0000FFFF&
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   17
         Top             =   960
         Width           =   1335
      End
      Begin OptionButton oState
         BackColor       =   &H00C0C0C0&
         Caption         =   "WAITING"
         Enabled         =   0   'False
         ForeColor       =   &H000000FF&
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   16
         Top             =   600
         Width           =   1215
      End
      Begin OptionButton oState
         BackColor       =   &H00C0C0C0&
         Caption         =   "IDLE"
         Enabled         =   0   'False
         ForeColor       =   &H0000FF00&
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   15
         Top             =   240
         Value           =   -1  'True
         Width           =   855
      End
   End
   Begin IPPORT IPPort1
      EOL             =   ""
      InBufferSize    =   2048
      Left            =   1680
      Linger          =   -1  'True
      LocalPort       =   0
      OutBufferSize   =   2048
      Port            =   0
      Top             =   960
   End
   Begin IPDAEMON IPDaemon1
      EOL             =   ""
      InBufferSize    =   2048
      Left            =   2160
      Linger          =   -1  'True
      OutBufferSize   =   2048
      Port            =   0
      Top             =   960
   End
   Begin OptionButton optBinary
      BackColor       =   &H00C0C0C0&
      Caption         =   "BINARY"
      Height          =   255
      Index           =   1
      Left            =   1560
      TabIndex        =   13
      Top             =   1800
      Width           =   975
   End
   Begin OptionButton optASCII
      BackColor       =   &H00C0C0C0&
      Caption         =   "ASCII"
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   12
      Top             =   1800
      Value           =   -1  'True
      Width           =   975
   End
   Begin CommandButton bConnect
      Caption         =   "Connect!!"
      Height          =   375
      Left            =   5280
      TabIndex        =   11
      Top             =   180
      Width           =   1335
   End
   Begin TextBox tOutput
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Courier New"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   3135
      HideSelection   =   0   'False
      Left            =   0
      MousePointer    =   1  'Arrow
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   10
      Top             =   2280
      Width           =   8655
   End
   Begin TextBox tRemote
      Height          =   285
      Left            =   5280
      TabIndex        =   7
      Text            =   "/pub/README"
      Top             =   1440
      Width           =   2775
   End
   Begin TextBox tLocal
      Height          =   285
      Left            =   120
      TabIndex        =   6
      Text            =   "C:\FTPTEST.TXT"
      Top             =   1440
      Width           =   2775
   End
   Begin TextBox tPassword
      Height          =   285
      Left            =   4440
      TabIndex        =   5
      Text            =   "[e-mail]"
      Top             =   720
      Width           =   2295
   End
   Begin TextBox tUserID
      Height          =   285
      Left            =   1320
      TabIndex        =   4
      Text            =   "anonymous"
      Top             =   720
      Width           =   1575
   End
   Begin TextBox tHost
      Height          =   285
      Left            =   1320
      TabIndex        =   0
      Text            =   "little"
      Top             =   240
      Width           =   3615
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Remote File"
      Height          =   255
      Index           =   4
      Left            =   5280
      TabIndex        =   9
      Top             =   1200
      Width           =   1575
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Local File"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   8
      Top             =   1200
      Width           =   1575
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Password:"
      Height          =   255
      Index           =   2
      Left            =   3360
      TabIndex        =   3
      Top             =   720
      Width           =   975
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "User ID:"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   2
      Top             =   720
      Width           =   855
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Host Name:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   1
      Top             =   240
      Width           =   1095
   End
Option Explicit
Dim rLocalAddress As String
Dim rResponseCode As Integer
Dim rResponseText As String
Const S_IDLE = 0
Const S_WAITING = 1
Const S_COMMAND = 2
Const M_UPLOAD = 0
Const M_DOWNLOAD = 1
Const M_LIST = 2
Sub bConnect_Click ()
tOutput = ""
Screen.MousePointer = 11
IPPort1.Connected = False 'disconnect previous connection
IPPort1.EOL = Chr$(13) & Chr$(10)
IPPort1.HostName = tHost
IPPort1.Port = 21
IPPort1.Connected = True
'wait for connection - give it 10 seconds
Dim After10Seconds: After10Seconds = Now + 10# / (3600# * 24#)
Do Until Now > After10Seconds
    If IPPort1.Connected Then Exit Do
    DoEvents
If Not IPPort1.Connected Then
    MsgBox "Connection timed out!!"
    GoTo Done
End If
SendCommand ""  'get server welcome message
'login
SendCommand "USER " & tUserID
'wait for server response
Do: DoEvents: Loop Until rResponseCode <> 0
'now send password
SendCommand "PASS " & tPassword
Done:
Screen.MousePointer = 0
End Sub
Sub Command1_Click ()
SendCommand "ABOR"
Screen.MousePointer = 0
End Sub
Sub Command2_Click ()
PrepareDataPort
Screen.MousePointer = 11
If oWhat(M_UPLOAD) Then
    oWhat(M_UPLOAD).ForeColor = &HFF&
    Open tLocal For Binary As #1
    SendCommand "STOR " & tRemote
ElseIf oWhat(M_DOWNLOAD) Then
    oWhat(M_DOWNLOAD).ForeColor = &HFF&
    Open tLocal For Binary As #1
    SendCommand "RETR " & tRemote
Else 'oWhat(M_LIST) then
    oWhat(M_LIST).ForeColor = &HFF&
    SendCommand "LIST " & tRemote
End If
End Sub
Sub Form_Load ()
IPPort1.HostName = IPPort1.LocalHostName
rLocalAddress = IPPort1.HostAddress
End Sub
Sub Form_Resize ()
tOutput.Width = ScaleWidth
tOutput.Height = Scaleheight - tOutput.Top
End Sub
Sub IPDaemon1_Connected (ConnectionID As Integer, StatusCode As Integer, Description As String)
On Error GoTo FlowControl
If oWhat(M_UPLOAD) Then
    Dim Text$
    Do While Not EOF(1)
        Text$ = Input$(1400, #1)
        IPDaemon1.DataToSend(ConnectionID) = Text$
    Loop
    IPDaemon1.Connected(ConnectionID) = False
End If
Exit Sub
FlowControl:
If Err = 25036 Then
    Dim BytesSent%: BytesSent% = IPDaemon1.BytesSent
    If BytesSent% > 0 Then  'strip bytes sent
        Text$ = Mid$(Text$, BytesSent% + 1)
    End If
    DoEvents   'wait a while
    Resume     'try again
Else  'handle other errors here
    MsgBox Error$
    Exit Sub
End If
End Sub
Sub IPDaemon1_DataIn (ConnectionID As Integer, Text As String, EOL As Integer)
If oWhat(M_LIST) Then
    Trace Text
ElseIf oWhat(M_DOWNLOAD) Then
    Put #1, , Text
End If
End Sub
Sub IPDaemon1_Disconnected (ConnectionID As Integer, StatusCode As Integer, Description As String)
Screen.MousePointer = 0
IPDaemon1.Listening = False
Close #1
oWhat(M_UPLOAD).ForeColor = 0
oWhat(M_DOWNLOAD).ForeColor = 0
oWhat(M_LIST).ForeColor = 0
End Sub
Sub IPPort1_DataIn (Text As String, EOL As Integer)
'trace
Trace Text
rResponseText = rResponseText & Text
'full line?
If EOL Then
    Trace Chr$(13) & Chr(10)
    If Mid$(Text, 4, 1) = " " Then
        rResponseCode = CInt(Left$(rResponseText, 3))
        rResponseText = Mid$(rResponseText, 5)
        'elaborate error checking should go here
        'please see RFC959 for more information
        If rResponseCode \ 100 = 1 Then
            oState(S_WAITING) = True
        Else
            oState(S_IDLE) = True
        End If
    End If
    rResponseText = ""  'reset buffer
End If
End Sub
Sub optASCII_Click (Index As Integer)
SendCommand "TYPE A"
End Sub
Sub optBinary_Click (Index As Integer)
SendCommand "TYPE I"
End Sub
Sub PrepareDataPort ()
IPDaemon1.Listening = True
Dim Port: Port = IPDaemon1.Port
Dim i%, x%, address$
address$ = rLocalAddress
For i% = 1 To 3
    x% = InStr(address$, ".")
    If x% <> 0 Then Mid$(address$, x%, 1) = ","
Next i%
SendCommand "PORT " & address$ & "," & Port \ 256 & "," & Port Mod 256
End Sub
'sends an FTP command to the server
'and returns the response code
Sub SendCommand (CommandText$)
rResponseCode = 0
If CommandText$ <> "" Then
    Trace CommandText$ & Chr$(13) & Chr$(10)
    oState(S_COMMAND) = True
    IPPort1.DataToSend = CommandText$ & Chr$(10)
End If
End Sub
Sub Trace (Text As String)
tOutput.SelStart = Len(tOutput)
tOutput.SelLength = 0
tOutput.SelText = Text
End Sub